home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / system / EditMain.pas < prev    next >
Pascal/Delphi Source File  |  1998-05-09  |  5KB  |  161 lines
  1. unit EditMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ComCtrls, StdCtrls, ShellAPI, ToolWin, ExtCtrls, RzPanel, Buttons,
  8.   RichEdit, RzStatus, RichEdit2;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     File1: TMenuItem;
  14.     Edit1: TMenuItem;
  15.     Format1: TMenuItem;
  16.     Help1: TMenuItem;
  17.     New1: TMenuItem;
  18.     Open1: TMenuItem;
  19.     Close1: TMenuItem;
  20.     N1: TMenuItem;
  21.     Save1: TMenuItem;
  22.     SaveAs1: TMenuItem;
  23.     N2: TMenuItem;
  24.     SaveSetttings1: TMenuItem;
  25.     Exit1: TMenuItem;
  26.     RzToolbar1: TRzToolbar;
  27.     FileNew: TSpeedButton;
  28.     FileOpen: TSpeedButton;
  29.     FileSave: TSpeedButton;
  30.     FilePrint: TSpeedButton;
  31.     RzSpacer1: TRzSpacer;
  32.     SpeedButton5: TSpeedButton;
  33.     SpeedButton6: TSpeedButton;
  34.     SpeedButton7: TSpeedButton;
  35.     RzSpacer2: TRzSpacer;
  36.     UndoButton: TSpeedButton;
  37.     EditCut: TSpeedButton;
  38.     EditCopy: TSpeedButton;
  39.     EditPaste: TSpeedButton;
  40.     RzSpacer3: TRzSpacer;
  41.     EditBold: TSpeedButton;
  42.     EditItalic: TSpeedButton;
  43.     EditUnderline: TSpeedButton;
  44.     RzSpacer4: TRzSpacer;
  45.     SpeedButton16: TSpeedButton;
  46.     EditDelete: TSpeedButton;
  47.     RzStatusBar1: TRzStatusBar;
  48.     RzClockStatus1: TRzClockStatus;
  49.     Font1: TMenuItem;
  50.     N3: TMenuItem;
  51.     Bold1: TMenuItem;
  52.     Italic1: TMenuItem;
  53.     Underline1: TMenuItem;
  54.     Strikeout1: TMenuItem;
  55.     RichEdit1: TRichEdit2;
  56.     RzStatusPane1: TRzStatusPane;
  57.     procedure FormCreate(Sender: TObject);
  58.     procedure RichEdit2SelectionChange(Sender: TObject);
  59.     procedure EditButtonClick (Sender: TObject);
  60.     procedure EditSelectionClick(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.     procedure EnableDisableToolBar;
  64.     procedure URLLinkNotification (Link: Pointer);
  65.   protected
  66.     procedure WMNotify (var Message: TWMNotify); message wm_Notify;
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. var
  72.   Form1: TForm1;
  73.  
  74. implementation
  75.  
  76. {$R *.DFM}
  77.  
  78. procedure TForm1.EnableDisableToolBar;
  79. var
  80.     GotSelection: Boolean;
  81.     SelStart, SelEnd: LongInt;
  82. begin
  83.     UndoButton.Enabled := RichEdit1.Perform (em_CanUndo, 0, 0) <> 0;
  84.     EditPaste.Enabled := IsClipboardFormatAvailable (cf_Text);
  85.     RichEdit1.Perform (em_GetSel, Integer (@SelStart), Integer (@SelEnd));
  86.     GotSelection := SelStart <> SelEnd;
  87.     EditDelete.Enabled := GotSelection;
  88.     EditCopy.Enabled := GotSelection;
  89.     EditCut.Enabled := GotSelection;
  90. end;
  91.  
  92. procedure TForm1.RichEdit2SelectionChange(Sender: TObject);
  93. begin
  94.     EnableDisableToolBar;
  95. end;
  96.  
  97. procedure TForm1.FormCreate(Sender: TObject);
  98. var
  99.     mask: Integer;
  100. begin
  101.     DragAcceptFiles (RichEdit1.Handle, True);
  102.     EnableDisableToolBar;
  103.     RichEdit1.Perform (em_AutoURLDetect, 1, 0);
  104.     mask := RichEdit1.Perform (em_GetEventMask, 0, 0);
  105.     mask := mask or enm_Link;
  106.     RichEdit1.Perform (em_SetEventMask, 0, mask);
  107. end;
  108.  
  109. procedure TForm1.EditButtonClick (Sender: TObject);
  110. begin
  111.     with Sender as TSpeedButton do RichEdit1.Perform (Tag, 0, 0);
  112.     EnableDisableToolBar;
  113. end;
  114.  
  115. procedure TForm1.EditSelectionClick(Sender: TObject);
  116. var
  117.     Style: Integer;
  118.     cfm: TCharFormat;
  119. begin
  120.     if Sender is TSpeedButton then Style := TSpeedButton(Sender).Tag else
  121.     if Sender is TMenuItem then Style := TMenuItem(Sender).Tag else Exit;
  122.     cfm.cbSize := sizeof (cfm);
  123.     RichEdit1.Perform (em_GetCharFormat, Integer (True), Integer (@cfm));
  124.     cfm.dwEffects := cfm.dwEffects xor Style;
  125.     RichEdit1.Perform (em_SetCharFormat, scf_Selection, Integer (@cfm));
  126.     EnableDisableToolBar;
  127. end;
  128.  
  129. procedure TForm1.WMNotify (var Message: TWMNotify);
  130. begin
  131.     if Message.NMHdr^.hwndFrom = RichEdit1.Handle then case Message.NMHdr^.code of
  132.         en_Link:    URLLinkNotification (Message.NMHdr);
  133.         // Add other notification types here....
  134.     end;
  135. end;
  136.  
  137. procedure TForm1.URLLinkNotification (Link: Pointer);
  138. type
  139.     // Need to redefine this - RICHTEXT.PAS gets it wrong!
  140.     TTextRange = record
  141.         chrg: TCharRange;
  142.         lpstrText: PAnsiChar;
  143.     end;
  144. var
  145.     sz: String;
  146.     TextRange: TTextRange;
  147.     pENLink: ^TENLink absolute Link;
  148. begin
  149.     with pENLink^ do begin
  150.         SetLength (sz, chrg.cpMax - chrg.cpMin);
  151.         TextRange.chrg := chrg;
  152.         TextRange.lpstrText := Pointer (sz);
  153.         RichEdit1.Perform (em_GetTextRange, 0, Integer (@TextRange));
  154.  
  155.         if Msg = wm_MouseMove then RzStatusPane1.Caption := sz
  156.         else if Msg = wm_LButtonDown then ShellExecute (Handle, 'open', PChar (sz), Nil, Nil, sw_Show);
  157.     end;
  158. end;
  159.  
  160. end.
  161.